home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / boot / profile.pl < prev    next >
Encoding:
Text File  |  1992-10-25  |  2.0 KB  |  83 lines
  1. /*  $Id: profile.pl,v 1.2 1992/10/25 16:30:52 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: profiler interface
  7. */
  8.  
  9. :- module($profile,
  10.     [ profiler/2
  11.     , show_profile/1
  12.     , profile/3
  13.     ]).
  14.  
  15. %    profile(-Old, +New)
  16. %    change or query profiling status.
  17.  
  18. profiler(Old, New) :-
  19.     $profile(OldInt, OldInt), 
  20.     $map_profile(Old, OldInt), 
  21.     atom(New), 
  22.     $map_profile(New, NewInt), !, 
  23.     $profile(_, NewInt).
  24.  
  25. $map_profile(off,       0).
  26. $map_profile(cumulative,  1).
  27. $map_profile(plain,       2).
  28.  
  29.  
  30. %   show_profile(N)
  31. %   Show the top N functions' profile. Negative numbers or 0 show ALL
  32. %   functions that have been called during profiling.
  33.  
  34. show_profile(N) :-
  35.     findall( triple(Perc, Calls, Module:Head), 
  36.          $profile_count(Module:Head, Calls, Perc), 
  37.          List), 
  38.     sort(List, Sorted), 
  39.     reverse(Sorted, HighFirst), 
  40.     format('~w~t~w =~41|~t~w~57| = ~w ~t~w~79|~n',
  41.            [ 'Predicate', 'Box Entries', 'Calls+Redos'
  42.            , 'Exits+Fails', 'Time'
  43.            ]),
  44.     format('~61t~79|~n'),
  45.     $show_profile(N, HighFirst).
  46.  
  47. $profile_count(Head, Calls, Perc) :-
  48.     current_predicate(_, Head), 
  49.     \+ predicate_property(Head, imported_from(_)), 
  50.     profile_count(Head, Calls, Perc), 
  51.     Calls \== 0.
  52.  
  53. $show_profile(0, _) :- !.
  54. $show_profile(_, []) :- !.
  55. $show_profile(N, [triple(Prom, Total, Pred)|Rest]) :-
  56.     $predicate_name(Pred, Name),
  57.     profile_box(Pred, Calls, Redos, Exits, Fails),
  58.     format('~w~t~D =~41|~t~D+~D~57| = ~D+~D ~t~1d%~79|~n',
  59.            [Name, Total, Calls, Redos, Exits, Fails, Prom]), 
  60.     succ(M, N), 
  61.     $show_profile(M, Rest).
  62.  
  63. :- module_transparent
  64.     profile/3,
  65.     $time_rval/2.
  66.  
  67. profile(Goal, Style, N) :-
  68.     memberchk(Style, [plain, cumulative]), !, 
  69.     profiler(_, off), 
  70.     reset_profiler, 
  71.     profiler(_, Style), 
  72.     $time_rval(Goal, Rval), 
  73.     profiler(_, off), 
  74.     show_profile(N), !, 
  75.     Rval == true.
  76. profile(_, _, _) :-
  77.     $warning('profile/3: second argument should be one of {plain, cumulative}'), 
  78.     fail.
  79.  
  80. $time_rval(Goal, true) :-
  81.     time(Goal), !.
  82. $time_rval(_, false).    
  83.